home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / _OPENDBF.PRG < prev    next >
Text File  |  1993-05-04  |  7KB  |  224 lines
  1. *' $Header:   E:/test/sysproc/doc/_opendbf.prv   1.0   12 Aug 1992 16:55:52   Bill Ramos  $
  2. *----------------------------------------------------------------------
  3. * PROCEDURE AND FUNCTIONS
  4. *   PROCEDURE _OpenDbf
  5. *   PROCEDURE _OpenIt 
  6. *----------------------------------------------------------------------
  7. PROCEDURE _OpenDbf
  8. PARAMETERS pc_file, pn_wa, pl_ok, pl_nolog, p__alias, pl_keepwa, pl_exclus
  9. *---------------------------------------------------------------------
  10. * NAME
  11. *   _OpenDbf - opens a DBF using PATH or Catalog
  12. *
  13. * DESCRIPTION
  14. *   The _OpenDbf procedure will open the DBF file in the <pn_wa>
  15. *   work area.  If it opened the DBF file OK, then <pl_ok> is
  16. *   set to .T., otherwise it is set to .F.  _OpenDbf will leave
  17. *   the opened file as the current work area.
  18. *
  19. *   If the file is already opened in another work area, _OpenDbf
  20. *   will close it, and re-open the file in the desired work area.
  21. *
  22. *   If there is an error, _OpenDbf will display the [File not found]
  23. *   error message.
  24. *
  25. * SYNOPSIS
  26. *   DO _OpenDbf WITH <pc_file>, <pn_wa>, <pl_ok>, <pl_nolog>, <pl_keepwa>
  27. *
  28. * PARAMETERS
  29. *   pc_file   = name of DBF file to open
  30. *   pn_wa     = work area to use for the file
  31. *   pl_ok     = if opened, set to .t., else set to .f.
  32. *   pl_nolog  = .T. use with NOLOG, .F. normal USE for transactions
  33. *   p__alias  = Alias name for the dbf, OPENS WITH "AGAIN NOUPDATE"
  34. *   pl_keepwa = .T. keep open in its current WA, .F. close and reopen
  35. *               in the assigned WA
  36. *   pl_exclus = If file should be opened exclusively
  37. *
  38. * EXAMPLE
  39. *   *-- Re-use the file in the desired work area
  40. *   USE GOODS IN 15
  41. *   ok = .T.
  42. *   DO _OpenDbf WITH "GOODS", 1, ok     && Opens GOODS in work area 1 vs 15
  43. *
  44. *   *-- Use the file in an available work area
  45. *   ok = .T.
  46. *   DO _OpenDbf WITH "VENDORS", SELECT(), ok
  47. *   IF .NOT. ok                         && If the file was not opened
  48. *     ...                               && Error recovery code here
  49. *   ENDIF
  50. *
  51. * LIMITATIONS
  52. *   None
  53. *
  54. * DEPENDENCIES
  55. *   Calls:  _CatOpen, _CatClose, _CatCode, _Err_Box
  56. *
  57. *---------------------------------------------------------------------
  58.  
  59.   PRIVATE lc_dbfname, lc_file, ll_catclsd, ll_opened, ln_code, ln_select
  60.   PRIVATE lCatalog
  61.  
  62.   lCatalog = SET( "CATALOG" ) = "ON" .AND. .NOT. ISBLANK( CATALOG() )
  63.   SET CATALOG OFF
  64.  
  65.   pl_ok = .F.                           && Assume open will fail
  66.   lc_file = TRIM( UPPER( pc_file ) )    && Trim the file name
  67.   lc_dbfname = lc_file + ".DBF"         && Form the DBF name for checks
  68.   ll_catclsd = .T.                      && Catalog closed to start flag
  69.  
  70.   IF FILE( lc_dbfname )                 && If the file exists
  71.  
  72.     ln_select = SELECT( pc_file )       && See if the file is already opened
  73.     IF ln_select > 0 .AND. ;
  74.        ln_select <> pn_wa               && If file is open in wrong WA
  75.  
  76.       IF .NOT. pl_keepwa
  77.  
  78.         IF TYPE( "p__alias" ) = "L"     && If no alias is defined, then
  79.           USE IN ( ln_select )          && Close the file first
  80.         ENDIF
  81.  
  82.       ELSE
  83.         SELECT ( ln_select )
  84.       ENDIF
  85.  
  86.     ENDIF
  87.  
  88.     DO _OpenIt                          && Open the given file
  89.   ELSE                                  && ... the file is not in path
  90.  
  91.     IF SELECT( "FXCATALOG" ) = 0        && If catalog is not open already
  92.       ll_opened = .F.                   && Assume that can't open catalog
  93.       DO _CatOpen WITH ll_opened        && try an open the catalog
  94.     ELSE
  95.       ll_opened = .T.                   && Flag catalog is open
  96.       ll_catclsd = .F.                  && Flag don't close catalog on exit
  97.     ENDIF
  98.  
  99.     IF ll_opened
  100.       SELECT FXCatalog                  && Position to opened catalog
  101.       ln_code = 0
  102.       DO _CatCode WITH lc_dbfname, ;
  103.                        ln_code          && Try and locate the DBF file
  104.  
  105.       IF FOUND()                        && If the file is in the catalog
  106.         lc_dbfname = FxCatalog->path    && Grab the full file path
  107.  
  108.         IF FILE( lc_dbfname )           && If the file is still around
  109.           ln_select = SELECT( lc_file ) && See if the file is already opened
  110.  
  111.           IF ln_select > 0 .AND. ;
  112.              ln_select <> pn_wa         && If file is open in wrong WA
  113.  
  114.             IF .NOT. pl_keepwa
  115.               USE IN ( ln_select )      && Close the file first
  116.             ELSE
  117.               SELECT ( ln_select )
  118.             ENDIF
  119.  
  120.           ENDIF
  121.  
  122.           DO _OpenIt                    && Open the given file
  123.         ENDIF
  124.  
  125.       ELSE
  126.         DO _Err_Box WITH [Cannot open file: ] + lc_dbfname
  127.         ll_opened = .F.
  128.       ENDIF
  129.  
  130.       IF ll_catclsd                     && If the catalog was closed before
  131.         DO _CatClose                    && Close the catalog file
  132.       ENDIF
  133.  
  134.     ENDIF   && ll_opened
  135.  
  136.   ENDIF   && FILE( lc_dbfname )
  137.  
  138.   IF lCatalog
  139.     SET CATALOG ON
  140.   ENDIF
  141.  
  142. RETURN
  143. *-- EOP:  _OpenDbf WITH pc_file, pn_wa, pl_ok, pl_nolog, p__alias, ;
  144. *--                     pl_keepwa, pl_exclus
  145.  
  146.  
  147.  
  148. PROCEDURE _OpenIt
  149. *---------------------------------------------------------------------
  150. * NAME
  151. *   _OpenIt
  152. *
  153. * DEPENDENCIES
  154. *   Must be called by _OpenDbf
  155. *
  156. * VARIABLES
  157. *   ll_exclus = Save current EXCLUSIVE setting
  158. *   All other variables for the routine come from _OpenDbf
  159. *
  160. *---------------------------------------------------------------------
  161.  
  162.   PRIVATE ll_exclus                     && Save EXCLUSIVE setting
  163.  
  164.   IF .NOT. pl_keepwa
  165.     SELECT ( pn_wa )                    && Select the desired work area
  166.  
  167.     IF pl_exclus .AND. SET( "EXCLUSIVE" ) = "OFF"
  168.       *-- If file should be opened exclusively and exclusive isn't already ON.
  169.       ll_exclus = .T.
  170.       SET EXCLUSIVE ON
  171.     ELSE
  172.       ll_exclus = .F.
  173.     ENDIF
  174.  
  175.     IF pl_nolog
  176.  
  177.       IF TYPE("p__alias ") = "L"
  178.         USE ( lc_dbfname ) ;
  179.            ALIAS &lc_file NOLOG         && Open the file with NOLOG option
  180.       ELSE
  181.         *-- Open the file with ALIAS option
  182.         USE ( lc_dbfname ) ;
  183.           ALIAS &p__alias NOLOG AGAIN NOUPDATE ;
  184.  
  185.       ENDIF
  186.  
  187.     ELSE
  188.  
  189.       IF TYPE("p__alias ") = "L"
  190.         USE ( lc_dbfname ) ALIAS &lc_file
  191.       ELSE
  192.        *-- Open the file with ALIAS option
  193.         USE ( lc_dbfname ) ALIAS &p__alias AGAIN NOUPDATE
  194.       ENDIF
  195.  
  196.     ENDIF
  197.  
  198.     IF ll_exclus
  199.       SET EXCLUSIVE OFF
  200.     ENDIF
  201.  
  202.   ENDIF
  203.  
  204.   IF TYPE( "FXL_Error" ) <> "L"
  205.  
  206.     IF _FileRoot( lc_dbfname ) = _FileRoot( DBF() )
  207.       pl_ok = .T.
  208.     ELSE
  209.       pl_ok = .F.
  210.       DO _Err_Box WITH [Cannot open file: ] + lc_dbfname
  211.     ENDIF
  212.  
  213.   ELSE
  214.     pl_ok = .F.
  215.     RELEASE FXL_Error
  216.   ENDIF
  217.  
  218. RETURN
  219. *-- EOP: _OpenIt
  220. *'-------------------------------------------------------------------------
  221. *' $Log:   E:/test/sysproc/doc/_opendbf.prv  $
  222. *'-------------------------------------------------------------------------
  223.  
  224.